#!/usr/bin/env perl

# dictionary generator 0.1 - turns dictionary files into language-specific dict dumps
# dict = [[char0, [payload0], [[char1, [payload1], [[char2, ...]]]]]]
# payload is [word, dict_mask] where dict_mask is the bits of the dicts it appears in

use strict;
$| = 1;

use constant {
	INDIR  => 'word_files',
	OUTDIR => 'generated_dictionaries',

	DICT_OUTFILE_PERL => 'dictionary.pl',
};

# dictionary_filename => powers of 2
# http://www.isc.ro/en/commands/lists.html
my %dict_masks = (
	twl06   => 1,
	sowpods => 2,
	ods     => 4,
	zynga   => 8,
);

{
	my $dict = &process_dictionaries;
	write_dict_perl([$dict]);
}

sub process_dictionaries {
	my $dict = [];

	for my $dict_name (keys %dict_masks){
		open my $word_file, '<', INDIR . "/$dict_name" or next;
		print "processing $dict_name...\n";

		while(<$word_file>){
			tr/\r\n//d;
			$_ = lc $_;
			next if /[^a-z]/;
			process_word($dict_masks{$dict_name}, $dict, join('', sort {$a cmp $b} split '', $_), $_, 0);
		}
	}
	print "done\n";

	return $dict;
}

sub write_dict_perl {
	my $dict = pop;
	require Storable;

	mkdir OUTDIR;
	open my $dict_file, '>', join('/', OUTDIR, DICT_OUTFILE_PERL) or die $!;
	Storable::store_fd($dict, $dict_file);
}

sub process_word {
	my($dict_mask, $dict, $word_asc, $word, $pos) = @_;

	my $char      = substr $word_asc, $pos,     1;
	my $char_next = substr $word_asc, $pos + 1, 1;

	my $i = bin_search($dict, $char);
	if(defined $dict->[$i]){
		if($char_next){
			process_word($dict_mask, $dict->[$i][2] ||= [], $word_asc, $word, $pos + 1);
		}
		else{
			my $j = bin_search($dict->[$i][1], $word);
			if(defined $dict->[$i][1][$j]){
				$dict->[$i][1][$j][1] |= $dict_mask;
			}
			else{
				$dict->[$i][1][$j] = [$word, $dict_mask];
			}
		}
	}

	else{
		if($char_next){
			my $dict_next = [];
			$dict->[$i] = [$char, [], $dict_next];
			process_word($dict_mask, $dict_next, $word_asc, $word, $pos + 1);
		}
		else{
			$dict->[$i] = [$char, [[$word, $dict_mask]]];
		}
	}
}

# from wikipedia :x
sub bin_search {
	my($arr, $str) = @_;
	return 0 unless @$arr;

	my $min = 1;
	my $mid;
	my $max = @$arr;

	my $cmp;
	do{
		$mid = int(($min + $max) / 2);
		$cmp = $str cmp $arr->[$mid - 1][0];
		if(!$cmp){
			$mid--;
			$min = $max + 1; # last
		}
		elsif($cmp > 0){
			$min = $mid + 1;
		}
		else{
			$max = $mid - 1;
		}
	} until $min > $max;

	# XXX adjust array if no match
	if($cmp){
		$mid-- if $cmp < 0;
		splice @$arr, $mid, 0, undef;
	}

	return $mid;
}
